home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / menurtn.com / MENUDEMO.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-09-25  |  7.5 KB  |  194 lines
  1. '*************************************************
  2. '*           Menu Routine Demo Program           *
  3. '*                                               *
  4. '*     Written by: Robert R. Smith               *
  5. '*     3812 Red Bud, Imperial MO  63052-1161     *
  6. '*************************************************
  7. '*     CIS: 72447,2643     GEnie: R.SMITH138     *
  8. '*************************************************
  9. '*                                               *
  10. '* Start up QuickBASIC with following parameters *
  11. '*                                               *
  12. '*        QB/l [drive:][\path]menurtns           *
  13. '*                                               *
  14. '*************************************************
  15.  
  16. DEFINT A-Z
  17. 'Define Constants
  18.  
  19. CONST True = 1
  20. CONST False = NOT True
  21.    
  22. CONST Black = 0
  23. CONST Blue = 1
  24. CONST Green = 2
  25. CONST Cyan = 3
  26. CONST Red = 4
  27. CONST Magenta = 5
  28. CONST Brown = 6
  29. CONST White = 7
  30. CONST Bright = 8
  31. CONST Blink = 16
  32. CONST Yellow = Brown + Bright
  33.  
  34. 'Declare Functions
  35.  
  36. DECLARE FUNCTION GetDate$ ()
  37. DECLARE FUNCTION GetTime$ ()
  38. DECLARE FUNCTION MenuBar% (Row%, Col%, MenuStr$, MenuFore%, MenuBack%, Reversed%)
  39. DECLARE FUNCTION MenuWindow% (Row%, Col%, ShadDir$, MenuTitle$, MenuStr$, OutLine%, WColor%, WText%, Reversed%)
  40. DECLARE FUNCTION Shadow% (Row%, Col%)
  41. DECLARE FUNCTION WaitKey$ (Row%, Col%, WaitText$)
  42.  
  43. 'Delcare Sub Routines
  44.  
  45. DECLARE SUB DrawBox (URow%, UCol%, LRow%, LCol%, ShadDir$, MenuTitle$, OutLine%, WColor%, WText%)
  46.  
  47. Esc$ = CHR$(27)
  48. Up$ = CHR$(0) + CHR$(72)
  49. PgUp$ = CHR$(0) + CHR$(73)
  50. Down$ = CHR$(0) + CHR$(80)
  51. PgDn$ = CHR$(0) + CHR$(81)
  52.  
  53. KEY OFF
  54. COLOR White, Blue
  55. CLS
  56.  
  57. 'Main loop
  58.  
  59. CONST MainMenu$ = " Documentation  Menu·window  Time·display  Date·display  Quit "
  60. CONST Menu$ = " Shadow·box  Menu·window·2  Time·display  Date·display  Quit "
  61. CONST SecondMenu$ = " Third·window·menu  Middle·choice  Last·choice  Quit "
  62. CONST ThirdMenu$ = " This·is·the·first·choice·of·the·third·menu  An·interesting·combination·of·functions  Quit·menu "
  63. CONST Numbers$ = "A B C D E F G Q"
  64.  
  65. VIEW PRINT 1 TO 25
  66.  
  67. DO
  68.    LOCATE , , 0
  69.      
  70.    MainTitle$ = "This menu is a combination of a MenuBar and Window"
  71.    CALL DrawBox(2, 9, 4, 74, "l", MainTitle$, Blue, Cyan, White + Bright)
  72.    SELECT CASE MenuBar%(3, 11, MainMenu$, Black, Cyan, Red + Bright)
  73.                       
  74.       CASE 1      'This if a demonstration of shadowed box
  75.          COLOR White, Blue
  76.          CLS
  77.          CALL DrawBox(9, 25, 13, 56, "L", "", Brown + Bright, Magenta, White + Bright)
  78.          COLOR White + Bright, Magenta
  79.          LOCATE 10, 29: PRINT "Please get printer ready"
  80.          Dummy$ = WaitKey$(12, 29, "Press any key to continue")
  81.          COLOR , Blue
  82.          CLS
  83.          CALL DrawBox(9, 25, 11, 56, "L", "", Brown + Bright, Magenta, White + Bright)
  84.          COLOR White + Bright, Magenta
  85.          LOCATE 10, 28, 0: PRINT "Printing.....Please Wait!!"
  86.          SHELL "TYPE MENURTNS.DOC > PRN"
  87.          LPRINT CHR$(12)
  88.          CLS
  89.                          
  90.       CASE 2      'This if the new Window Menu selection
  91.          COLOR White, Blue
  92.          DO
  93.             FirstMenu$ = "N"
  94.             SELECT CASE MenuWindow%(14, 10, "", "Menu·Window", Menu$, Cyan + Bright, Cyan, White + Bright, Blue)
  95.                CASE 1
  96.                   CALL DrawBox(7, 30, 22, 65, "R", "Right Shadowed Box", Yellow, Brown, White + Bright)
  97.                CASE 2
  98.                   DO
  99.                      EndSecondMenu$ = "N"
  100.                      SELECT CASE MenuWindow%(11, 23, "l", "Menu·Window·2", SecondMenu$, Green + Bright, Green, Yellow, White + Bright)
  101.                         CASE 1
  102.                            DO
  103.                               EndThirdMenu$ = "N"
  104.                               SELECT CASE MenuWindow%(7, 14, "r", "Third Test Window", ThirdMenu$, Blue + Bright, Cyan, Black, Red)
  105.                                  CASE 1
  106.                                  CASE 2
  107.                                     DO
  108.                                        EndLastMenu$ = "N"
  109.                                        CALL DrawBox(12, 53, 21, 75, "L", "Interesting Combo", Yellow, Magenta, White + Bright)
  110.                                        COLOR White, Magenta
  111.                                        LOCATE 13, 55: PRINT "Menu Bar"
  112.                                        LOCATE 14, 55: PRINT "Second Option"
  113.                                        LOCATE 15, 55: PRINT "Third Option"
  114.                                        LOCATE 16, 55: PRINT "Fourth Option"
  115.                                        LOCATE 17, 55: PRINT "Fifth Option"
  116.                                        LOCATE 18, 55: PRINT "Sixth Option"
  117.                                        LOCATE 19, 55: PRINT "Last Option"
  118.                                        LOCATE 20, 55: PRINT "Quit"
  119.                                        SELECT CASE MenuWindow%(12, 47, "L", "", Numbers$, Yellow, Magenta, White + Bright, Black)
  120.                                           CASE 1
  121.                                              SELECT CASE MenuBar%(19, 15, Menu$, Black, Cyan, Red + Bright)
  122.                                              END SELECT
  123.                                           CASE 2
  124.                                           CASE 3
  125.                                           CASE 4
  126.                                           CASE 5
  127.                                           CASE 6
  128.                                           CASE 7
  129.                                           CASE ELSE
  130.                                              EndLastMenu$ = "Y"
  131.                                        END SELECT
  132.                                     LOOP UNTIL EndLastMenu$ = "Y"
  133.                                  CASE ELSE
  134.                                     EndThirdMenu$ = "Y"
  135.                               END SELECT
  136.                            LOOP UNTIL EndThirdMenu$ = "Y"
  137.                         CASE 2
  138.                         CASE 3
  139.                         CASE ELSE
  140.                            EndSecondMenu$ = "Y"
  141.                      END SELECT
  142.                   LOOP UNTIL EndSecondMenu$ = "Y"
  143.                CASE 3      'This will print the current time
  144.                   COLOR White, Blue
  145.                   LOCATE 22, ((80 - LEN(GetTime$)) / 2) - 10
  146.                   PRINT GetTime$; " at time of key press";
  147.                
  148.                CASE 4      'This will print the current date
  149.                   COLOR White, Blue
  150.                   LOCATE 23, ((80 - LEN(GetDate$)) \ 2) - 10
  151.                   PRINT GetDate$; " at time of key press"
  152.  
  153.                CASE ELSE
  154.                   FirstMenu$ = "Y"
  155.             END SELECT
  156.          LOOP UNTIL FirstMenu$ = "Y"
  157.          COLOR White, Blue
  158.          'CLS
  159.                          
  160.       CASE 3
  161.          COLOR White, Blue
  162.          CLS
  163.          LOCATE 12, 28: PRINT "Press any key to continue"
  164.          Response$ = ""
  165.          DO
  166.             Response$ = INKEY$
  167.             LOCATE 10, 25: PRINT "The current time is now "; GetTime$
  168.          LOOP WHILE Response$ = ""
  169.          CLS
  170.        
  171.       CASE 4
  172.          COLOR White, Blue
  173.          CLS
  174.          LOCATE 12, 28: PRINT "Press any key to continue"
  175.          Response$ = ""
  176.          DO
  177.             Response$ = INKEY$
  178.             LOCATE 10, 25: PRINT "Today's date is "; GetDate$
  179.          LOOP WHILE Response$ = ""
  180.          CLS
  181.         
  182.       CASE ELSE   'Exit loop
  183.          quitFlag% = True
  184.                          
  185.    END SELECT
  186. LOOP UNTIL quitFlag%
  187.   
  188. 'Terminate Program
  189.  
  190. COLOR White, Blue
  191. CLS
  192. END
  193.  
  194.